In [2]:
library(IRdisplay)
library(repr)
library(tensorflow)
library(keras)
library(imager)
library(R6)
In [3]:
keras_backend <- backend()
In [7]:
display_html("<style>
@import url('https://fonts.googleapis.com/css?family=Orbitron|Roboto');
body {background-color: gainsboro;}
a {color: #37c9e1; font-family: 'Roboto';}
h1 {color: #37c9e1; font-family: 'Orbitron'; text-shadow: 4px 4px 4px #ccc;}
h2, h3 {color: slategray; font-family: 'Orbitron'; text-shadow: 4px 4px 4px #ccc;}
h4 {color: #818286; font-family: 'Roboto';}
span {text-shadow: 4px 4px 4px #ccc;}
div.output_prompt, div.output_area pre {color: slategray;}
div.input_prompt, div.output_subarea {color: #37c9e1;}
div.output_stderr pre {background-color: gainsboro;}
div.output_stderr {background-color: slategrey;}
</style>")
Choose and Display Images¶
In [4]:
original_file <- "art_images/16.png"
style_file <- "art_images/12.png"
In [5]:
original <- load.image(original_file)
options(repr.plot.width=4,repr.plot.height=4)
par(mar=c(1,1,1,1))
dim(original)
plot(original,axes=F)
In [6]:
style <- load.image(style_file)
options(repr.plot.width=4,repr.plot.height=4)
par(mar=c(1,1,1,1))
dim(style)
plot(style,axes=F)
Preprocess¶
In [7]:
original_image <- image_load(original_file)
original_width <- original_image$size[[1]]
original_height <- original_image$size[[2]]
original_image_nrows <- 400
original_image_ncols <- as.integer(original_width * original_image_nrows / original_height)
In [8]:
par(mar=c(1,1,1,1))
plot(as.raster(image_to_array(original_image)/255))
In [9]:
preprocess_image <- function(file) {
image <- image_load(file,target_size=c(original_image_nrows,original_image_ncols)) %>%
image_to_array() %>%
array_reshape(c(1, dim(.)))
return(imagenet_preprocess_input(image))
}
deprocess_image <- function(x) {
x <- x[1,,,]
# Remove zero-center by mean pixel
x[,,1] <- x[,,1] + 103.939
x[,,2] <- x[,,2] + 116.779
x[,,3] <- x[,,3] + 123.68
# bgr ⟹ rgb
x <- x[,,c(3,2,1)]
x[x > 255] <- 255
x[x < 0] <- 0
x[] <- as.integer(x) / 255
return(x)
}
In [10]:
original_image <- keras_backend$constant(preprocess_image(original_file))
style_image <- keras_backend$constant(preprocess_image(style_file))
transfer_image <- keras_backend$placeholder(c(1L,original_image_nrows,original_image_ncols,3L))
input_tensor <- keras_backend$concatenate(list(original_image,style_image,transfer_image),axis=0L)
VGG19 Usage¶
In [11]:
model <- application_vgg19(input_tensor=input_tensor,
weight="imagenet",
include_top=FALSE)
summary(model)
In [12]:
original_loss <- function(original,transfer) {keras_backend$sum(keras_backend$square(transfer - original))}
In [13]:
gram_matrix <- function(x) {
features <- keras_backend$batch_flatten(keras_backend$permute_dimensions(x,list(2L,0L,1L)))
return(keras_backend$dot(features,keras_backend$transpose(features)))
}
In [14]:
style_loss <- function(style,transfer){
channels <- 3
size <- original_image_nrows * original_image_ncols
return(keras_backend$sum(keras_backend$square(gram_matrix(style) - gram_matrix(transfer))) /
(4 * channels^2 * size^2))
}
In [15]:
variation_loss <- function(x) {
y_ij <- x[,1:(original_image_nrows - 1L),1:(original_image_ncols - 1L),]
y_i1j <- x[,2:(original_image_nrows),1:(original_image_ncols - 1L),]
y_ij1 <- x[,1:(original_image_nrows - 1L), 2:(original_image_ncols),]
row_diff <- keras_backend$square(y_ij - y_i1j)
col_diff <- keras_backend$square(y_ij - y_ij1)
return(keras_backend$sum(keras_backend$pow(row_diff + col_diff, 1.25)))
}
In [16]:
layers_dict <- lapply(model$layers, `[[`, "output")
names(layers_dict) <- lapply(model$layers, `[[`, "name")
original_layer <- "block5_conv2"
style_layers = c("block1_conv1","block2_conv1","block3_conv1","block4_conv1","block5_conv1")
In [17]:
original_weight <- 0.025
style_weight <- 1.0
variation_weight <- 1e-4
In [18]:
loss <- keras_backend$variable(0.0)
layer_features <- layers_dict[[original_layer]]
original_features <- layer_features[1,,,]
transfer_features <- layer_features[3,,,]
loss <- loss + original_loss(original_features,transfer_features) * original_weight
In [19]:
for (layer_name in style_layers){
layer_features <- layers_dict[[layer_name]]
style_features <- layer_features[2,,,]
transfer_features <- layer_features[3,,,]
loss <- loss + style_loss(style_features,transfer_features) * (style_weight / length(style_layers))
}
In [20]:
loss <- loss + variation_loss(transfer_image) * variation_weight
In [21]:
gradients <- keras_backend$gradients(loss,transfer_image)[[1]]
fetch_loss_and_gradients <- keras_backend$`function`(list(transfer_image),list(loss, gradients))
evaluate_loss_and_gradients <- function(image) {
image <- array_reshape(image, c(1,original_image_nrows,original_image_ncols,3))
outputs <- fetch_loss_and_gradients(list(image))
return(list(
loss_value = outputs[[1]],
gradient_values = array_reshape(outputs[[2]],dim=length(outputs[[2]]))
))
}
In [22]:
Evaluator <- R6Class("Evaluator",
public = list(
loss_value = NULL,
gradient_values = NULL,
initialize = function() {
self$loss_value <- NULL
self$gradient_values <- NULL
},
loss = function(x){
loss_and_gradients <- evaluate_loss_and_gradients(x)
self$loss_value <- loss_and_gradients$loss_value
self$gradient_values <- loss_and_gradients$gradient_values
self$loss_value
},
gradients = function(x){
gradient_values <- self$gradient_values
self$loss_value <- NULL
self$gradient_values <- NULL
gradient_values
}
)
)
evaluator <- Evaluator$new()
Display Style Transfer¶
In [23]:
iterations <- 20
dimensions <- c(1,original_image_nrows,original_image_ncols,3)
x <- preprocess_image(original_file)
x <- array_reshape(x,dim=length(x))
In [24]:
for (i in 1:iterations) {
# Run L-BFGS
opt <- optim(
array_reshape(x, dim=length(x)),
fn = evaluator$loss,
gr = evaluator$gradients,
method = "L-BFGS-B",
control = list(maxit=15)
)
cat("Loss:", opt$value, "\n")
image <- x <- opt$par
image <- array_reshape(image,dimensions)
im <- deprocess_image(image)
plot(as.raster(im))
}
